#!/usr/local/bin/perl

# author: Christian Girardi
# last modify: 10 ottobre 2003
# note: Libreria di API per MultiWordnet che usa strutture dati serializzate

use Storable qw(store retrieve freeze thaw dclone);

#set the directory where you stored the files .ser
my $mwnser_path = "mwndata1.4.3";

#language is according to the file name into $mwnser_path. 
#Look the file called *_synset.ser. The * value could be the language value.
#For instance if there is english_synset.ser file, then on possibile value of $language is "english")
my $language = "english";

my %posid = ("n" => 0,
	     "v" => 1,
	     "a" => 2,
	     "r" => 3);

my %reltypes = ("hypernym" => "@",
		#"hyponym" => "~",
		"hyponym" => "-@",
		#"member-of" => "#m",
		#"substance-of" => "#s",
		#"part-of" => "#p",
		"member-of" => "-%m",
		"substance-of" => "-%s",
		"part-of" => "-%p",
		"has-member" => "%m",
		"has-substance" => "%s",
		"has-part" => "%p",
		"attribute" => "=",
		"entailment" => "*",
		"causes" => ">",
		"verb-group" => "\$",
		"antonym" => "!",
		"similar-to" => "&",
		"participle" => "<",
		"pertains-to" => "\\",
		"is-value-of" => "=",
		"also-see" => "^",
		"antonym" => "!",
		"derived-from"=>"\\",
		"nearest" => "|",
		"composed-of" =>"+c",
		#"composes" => "-c",
		"composes" => "-+c",
		);
			 

sub set_mwn_path {
    my ($path) = @_;	
    $mwnser_path = $path; 
}


####               ####
#  MULTIWORDNET API   #
####               ####

# This procedure returns a list of synset's id. 
# The value of language can be "italian" or "english"; the value of pos can be "n" "v" "r" "a" or "all"
sub get_synsets {
    my ($lemma,$pos,$language) = @_;
    
    #my %hash = %{get_mwntable($language . "_index")};
    #$synsets = $hash{$lemma};
    #print "## " . $synsets ."\n";
    $table = $language . "_index";
    get_mwntable($table);
    $synsets = $$table{$lemma};

    if ($pos =~ /^[n|v|a|r]$/) {
    	@list_pos = split(",",$synsets);
    	$synsets = $list_pos[$posid{$pos}];
    } else {
	$synsets =~ s/,/ /g;
    }
    
    return split(" ",$synsets);
}


# This procedure returns a list of lemmas. The id must be like "n#06309747"
# The value of language can be "italian" or "english";
sub get_lemmas {
    my ($id,$language) = @_;
    
    #my %hash = %{get_mwntable($language . "_synset")};    
    #return split(" ",$hash{$id});

    $table = $language . "_synset";
    get_mwntable($table);
    return split(" ", $$table{$id});

}

# This procedure returns the gloss of a synset. The id must be like "n#06309747"
# The value of language can be "italian" or "english";
sub get_gloss {
    my ($id,$language) = @_;
    
    $table = $language . "_gloss";
    get_mwntable($table);
    return $$table{$id};
}

# This procedure returns a list of relation starting from a synset
sub get_relation_types {
    my ($id) = @_;
    
    $table = "reltypes";
    get_mwntable($table);
    @relnames;
    @types = split(" ", $$table{$id});
    if ($#types > -1) {
	while ( my($name,$type) = each (%reltypes)) {
	    if (lsearch_exact($type,@types) != -1) {
		if (lsearch_exact($type,@relnames) == -1) {
		    push(@relnames,$name);
		}
	    }
	}
    }
    return @relnames;	
}


# This procedure returns a list of id according to a certain relation 
# (see type mark on db_schema_README-1_4_2.txt of MultiWordNet distribution).
# The id must be like "n#06309747".
#
# es. get_relation_synsets("n#06309747","hyponym");
sub get_relation_synsets {
    my ($id,$relname,$lang) = @_;
       
    #$table = get_typename($reltypes{$reltype},$lang);
    $table = "relations";
    get_mwntable($table);
    $type = $reltypes{$relname}; 
    if ($type !~ /^\s*$/) {
	return split(" ", $$table{$type.$id});
    } else {
	print STDERR "WARNING! The relation '$relname' is not defined.\n";
    }
    return ();
}

#This function returns a kind relation of a synset (ricorsive)
#example: my @hypers = get_relation_synsets_ricorsive("n#N0000011","hypernym");
sub get_relation_synsets_ricorsive {
    my ($id,$type,@rels) = @_;
    my @synrel = get_relation_synsets($id,$type);
    #print "!!" . join(" ",@synrel) . "\n";
    
    foreach my $rel (@synrel) {
    	if (join(" ",@rels) !~ /$rel/) {
	    push(@rels,$rel);	    	
	    @rels = get_relation_synsets_ricorsive($rel,$type,@rels);
	}
    }
    return @rels;    
}	



#This function returns hypernyms of a synset paths 
#example: my @hypers = get_hype_path("n#N0000011");
sub get_hype_path {
    my ($id,$i,@all_hypers) = @_;
    #print "!!" . join(" ",@hypers) . "\n";
    @ref_node = ();
    if (!defined($i)) {
	$i = 0;
    } else {
	@ref_node = @{ $all_hypers[$i] };
    }
    my @hypers = get_relation_synsets($id,"hypernym");
#    print STDERR ">> " .join(" ",@hypers);
    if ($#hypers > 0) {
	for ($e=0; $e < $#hypers; $e++) {
	    push @all_hypers, [ @ref_node ];
	}
    }
    my $rnum = $i;
    foreach my $rel (@hypers) {
	@all_node = @{ $all_hypers[$rnum] };
	push(@all_node,$rel);	    	
	$all_hypers[$rnum] = [ @all_node ];
	#print "$i,$rnum." . join(" ",@{ $all_hypers[$rnum] }) ."\n";
	@all_hypers = get_hype_path($rel,$rnum,@all_hypers);
	$rnum++;
    }
    
    return @all_hypers;
}	

# This function returns the semfields of a synset
sub get_synset_semfield {
    my ($id)=@_;
    
    #my %hash = %{get_mwntable("semfield")};    
    #return split(" ",$hash{$id}); 

    $table = "semfield";
    get_mwntable($table);
    return split(" ", $$table{$id});
    #return split(" ",$hash_semfield{$id}); 
}

# This function returns the list of the semfields
sub get_semfields {
    
    #my %hash = %{get_mwntable("semfield")};    
    #return split(" ",$hash{$id}); 

    $table = "semfield_hierarchy";
    get_mwntable($table);
    return keys(%$table);
}

sub get_lemma_semfield {
    my ($semfield)=@_;

	$table = "semfield_lemma";
    get_mwntable($table);
    return $$table{$semfield};	
}

# This function returns the sumo label about a synset
sub get_synset_sumo {
    my ($id)=@_;
    
   # my %hash = %{get_mwntable("sumo")};    
   # return split(" ",$hash{$id}); 

    $table = "sumo";
    get_mwntable($table);
    return split(" ", $$table{$id});

    #return split(" ",$hash_sumo{$id}); 
}



sub get_mwntable {
    my ($hashname) = @_;
    if (!defined %$hashname) {	
	if (-e $mwnser_path ."/". $hashname . "\.ser") {
	    print STDERR "Loading MWN $hashname table...\n";
	    %$hashname =  %{retrieve ($mwnser_path ."/". $hashname . "\.ser")};
     	} else {
	    print STDERR "Error! The file $mwnser_path/$hashname.ser has not been found. Check the variable \$mwnser_path into file multiwordnet_ram.pm.\n";
	    exit;
     	}
    }
    return $hashname;
}    


####               ####
#  UTILITY FUNCTIONS  #
####               ####

# This procedure returns 1 if id is a valid synset id, 0 otherwise.
sub is_valid_id {
    my ($id) = @_;
    if ($id =~ /^[n|v|a|r]#[A-Z0-9]\d\d\d\d\d\d\d$/) {
	return 1;
    }
    return 0;
} 

sub get_typename {
    my ($reltype,$lang)=@_;
    if ($reltype eq "@") {
	return "relhype";
    } elsif ($reltype eq "!") {
	return $lang."_relanto";
    } elsif ($reltype eq "~") {
	return "relhypo";
    } elsif ($reltype =~ /%./) {
	return "relholo";
    } 
    return "";
}

sub lsearch_exact {
    my ($el,@list) = @_;

    $position = 0;
    #print STDERR "lsearch($el,(". join(",",@list) . ")) ";
    foreach $item (@list) {
	if ($item eq $el) {
	    return $position;
	}
	$position++;
    }

    return -1;
}

1;


